home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / PINBSRC.ZIP / _SOUND2.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-02  |  4KB  |  181 lines
  1. { for TABLE2 !!! }
  2.  
  3. procedure init_load_sound;
  4. var poin,poin1:pointer;
  5. begin
  6.   getmem(poin1,1);
  7.   getmem(poin,65536-(Seg(poin1^) Shl 4 + Ofs(poin1^))-8);
  8. end;
  9.  
  10. procedure load_sound(soundnr:byte;soundname:string);
  11. var f:file;
  12.     error:word;
  13.     poin:pointer;
  14. begin
  15.   Assign(f,soundname);
  16.   {$I-}
  17.   Reset(f,1);
  18.   {$I+}
  19.   getmem(poin,1);
  20.   if 65536-(Seg(poin^) Shl 4 + Ofs(poin^))<Filesize(f) then
  21.   begin
  22.     getmem(poin,65536-((Seg(poin^) Shl 4 + Ofs(poin^))));
  23.     getmem(sounds[soundnr],filesize(f));
  24.   end else
  25.   begin
  26.    freemem(poin,1);
  27.    getmem(sounds[soundnr],filesize(f));
  28.   end;
  29.   blockread(f,sounds[soundnr]^,filesize(f),error);
  30.   soundlength[soundnr]:=filesize(f);
  31.   close(f);
  32. end;
  33.  
  34. procedure play(soundnr:byte);
  35. begin
  36.   if not UseSound then exit;
  37.   dmastop;
  38.   playback(sounds[soundnr],soundlength[soundnr],19000);
  39. end;
  40.  
  41.  Const dsp_adr    : word = $220;
  42.    dsp_irq        : byte = $5;
  43.    SbRegDetected : BOOLEAN = FALSE;
  44.  
  45.  var SbVersMaj : byte;
  46.      SbVersMin : byte;
  47.      SbVersStr : string[5];
  48.  
  49.  function Reset_sb : boolean;
  50.  const ready = $AA;
  51.  var   ct, stat : BYTE;
  52.  BEGIN
  53.   port [ dsp_adr+ $6 ]  :=  1 ;
  54.         for ct :=1 to 100 do;
  55.  
  56.      port [ dsp_adr+ $6 ]  :=  0 ;
  57.      stat := 0;
  58.      ct   := 0;
  59.      while (stat <> ready)
  60.      and   (ct < 100)   do begin
  61.        stat := PORT[dsp_adr+$E];
  62.        stat := PORT[dsp_adr+$a];
  63.        inc(ct);
  64.   end ;
  65.      Reset_sb := (stat = ready);
  66.   end;
  67.  
  68.  
  69.  
  70.  
  71.  function Detect_Reg_sb : boolean;
  72.  VAR Port, Lst : word;
  73.  BEGIN
  74.   Detect_Reg_sb :=  SbRegDetected;
  75.   IF SbRegDetected THEN EXIT;
  76.   Port := $210;
  77.   Lst  := $280;
  78.  
  79.   while (not SbRegDetected)
  80.   and   (Port <= Lst)  do begin
  81.     dsp_adr := Port;
  82.     SbRegDetected := Reset_sb;
  83.     if not SbRegDetected then
  84.  
  85.      inc(Port, $10);
  86.   end ;
  87.      Detect_Reg_sb := SbRegDetected;
  88.  end;
  89.  
  90.  function SbReadByte : byte;
  91.  
  92.  begin;
  93.    while port[dsp_adr+$a] = $AA do ;
  94.    SbReadByte :=  port[dsp_adr+$a];
  95.  end;
  96.  
  97.  
  98.  procedure wr_dsp(v : byte);
  99.  begin;
  100.   while port[dsp_adr+$c] >= 128 do ;
  101.    port[dsp_adr+$c] :=  v;
  102.  end;
  103.  
  104.  
  105.  function GetDSPVersion : string;
  106.  
  107.  var i : word;
  108.      t : WORD;
  109.      s :  STRING [ 2 ] ;
  110.   begin
  111.    wr_dsp($E1);
  112.    SbVersMaj :=  SbReadByte;
  113.    sbVersMin :=  SbReadByte;
  114.    str(SbVersMaj, SbVersStr);
  115.    SbVersStr :=  SbVersStr +  '.';
  116.    str(SbVersMin, s);
  117.    if SbVersMin > 9 then
  118.      SbVersStr :=  SbVersStr +   s
  119.    else
  120.      SbVersStr :=  SbVersStr + '0' + s;
  121.    GetDSPVersion := SbVersStr;
  122.  end;
  123.  
  124.  function wrt_dsp_adr : string;
  125.  {
  126.   Liefert die Base-Adresse des SB als
  127.   String zurück
  128.  }
  129.  begin;
  130.    case dsp_adr of
  131.     $210 : begin wrt_dsp_adr := '210'; dsp_adr := 1; end;
  132.     $220 : begin wrt_dsp_adr := '220'; dsp_adr := 2; end;
  133.     $230 : begin wrt_dsp_adr := '230'; dsp_adr := 3; end;
  134.     $240 : begin wrt_dsp_adr := '240'; dsp_adr := 4; end;
  135.     $250 : begin wrt_dsp_adr := '250'; dsp_adr := 5; end;
  136.     $260 : begin wrt_dsp_adr := '260'; dsp_adr := 6; end;
  137.     $270 : begin wrt_dsp_adr := '270'; dsp_adr := 7; end;
  138.     $280 : begin wrt_dsp_adr := '280'; dsp_adr := 8; end;
  139.     END ;
  140.  end;
  141.  
  142. procedure detect_soundblaster;
  143. begin
  144.   UseSound := False;
  145.   if detect_reg_sb then begin
  146.         writeln('SoundBlaster ',GetDSPVersion,' at base Address ',
  147.                 wrt_dsp_adr,'h found.');
  148.             UseSound := true;
  149.     end else begin
  150.       writeln('No Soundblaster or compatible found!');
  151.       UseSound := false;
  152.     end;
  153. end;
  154.  
  155. procedure init_soundkit;
  156. var h : byte;
  157. begin
  158.  {load them}
  159.   init_load_sound;
  160.           load_sound(snd1,'sound\1.snd');
  161.           load_sound(snd2,'sound\2.snd');
  162.           load_sound(snd3,'sound\3.snd');
  163.           load_sound(snd4,'sound\4.snd');
  164.           load_sound(snd5,'sound\5.snd');
  165.           load_sound(snd6,'sound\6.snd');
  166.           load_sound(snd7,'sound\7.snd');
  167.           load_sound(snd8,'sound\8.snd');
  168.           load_sound(snd9,'sound\9.snd');
  169.           load_sound(snd10,'sound\10.snd');
  170.           load_sound(snd11,'sound\11.snd');
  171.           load_sound(snd12,'sound\12.snd');
  172.           load_sound(snd13,'sound\13.snd');
  173.           load_sound(snd14,'sound\14.snd');
  174.   if resetDSP(dsp_Adr) then
  175.   begin
  176.     writeln('RESET FAILED');
  177.   end;
  178.   h := SBReadByte;
  179.   h := SpeakerOn;
  180.  
  181. end;